home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / filesets.tcl < prev    next >
Encoding:
Text File  |  1994-07-07  |  5.4 KB  |  175 lines  |  [TEXT/ALFA]
  1.  
  2. #===============================================================================================
  3. # Create new filesets either by the "Utils:Add Fileset..." menu item. These 
  4. # filesets can be made permanent by "Utils:Dump Fileset..."ing the fileset 
  5. # to immediately below.
  6. #
  7. # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  8. # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  9. # on occasion, but this isn't critical.
  10. #===============================================================================================
  11.  
  12. #===========================================================================
  13. # The filesets.
  14. #===========================================================================
  15.  
  16. # Build some filesets on the fly.
  17. catch {unset fileSets}
  18. catch {unset currFileSet}
  19. catch {set fileSets(HomeDir) [glob -t TEXT "$HOME:*"]}
  20. catch {set fileSets(Help) [glob -t TEXT   "$HOME:*"]}
  21. catch {set fileSets(System) [glob -t TEXT "$HOME:Tcl:SystemCode:*.tcl"]}
  22. catch {set fileSets(User) [glob -t TEXT   "$HOME:Tcl:UserCode:*.tcl"]}
  23.  
  24.  
  25. set currFileSet ""
  26.  
  27. #===========================================================================
  28. # The support routines.
  29. #===========================================================================
  30. # Called from Alpha to get list of files for current file set.
  31. proc getCurrFileSet {} {
  32.     global fileSets
  33.     global currFileSet
  34.     return $fileSets($currFileSet)
  35. }
  36.  
  37. # Called from Alpha to get names. The first name returned is taken to 
  38. # be the current fileset.
  39. proc getFileSetNames {} {
  40.     global fileSets
  41.     global currFileSet
  42.     set ind [lsearch [array names fileSets] $currFileSet]
  43.     if {$ind < 0} {set ind 0}
  44.     return [linsert [lsort [lreplace [array names fileSets] $ind $ind]] 0 $currFileSet]
  45. }
  46.  
  47.  
  48. # Keep 'sets' menu up to date.
  49. trace vdelete currFileSet w shadowCurrFileSet
  50. trace variable currFileSet w shadowCurrFileSet
  51. proc shadowCurrFileSet {nm1 nm2 op} {
  52.     global fileSets
  53.     global currFileSet
  54.     foreach name [array names fileSets] {
  55.         if {$name == $currFileSet} {
  56.             markMenuItem -m choose $name on
  57.         } else {
  58.             markMenuItem -m choose $name off
  59.         }
  60.     }
  61.     return $currFileSet
  62. }
  63.  
  64. # Called in response to user changing filesets from the fileset menu.
  65. proc changeFileSet {menu item} {
  66.     global currFileSet
  67.     
  68.     markMenuItem -m choose $currFileSet off
  69.     set currFileSet $item
  70.     markMenuItem -m choose $currFileSet on
  71. }
  72.  
  73.  
  74. #===========================================================================
  75. # Add fileset.
  76. #===========================================================================
  77. proc createFileset {} {
  78.     global fileSets
  79.     global currFileSet
  80.     
  81.     set name [getline "New fileset name:" ""]
  82.     if {![string length $name]} return
  83.     
  84.     set dir [string trim [get_directory] ":"]
  85.     if {![string length $dir]} return
  86.     
  87.     set filePat [getline "File pattern:" "*"]
  88.     if {![string length $filePat]} return
  89.     
  90.     set "fileSets($name)" [glob -t TEXT "$dir:$filePat"]
  91.     menu -n choose -m -p changeFileSet [lsort [array names fileSets]]
  92.     set currFileSet $name
  93.  
  94.     if {[askyesno "Save new fileset?"] == "yes"} {
  95.         addUserLine "set \"fileSets($name)\" \[glob -t TEXT  \"$dir:$filePat\"\]"
  96.         addUserLine "addMenuItem choose \"$name\""
  97.     }
  98.     makeFilesetMenu
  99. }
  100.  
  101.  
  102. #===========================================================================
  103. # Dump fileset to current window. If you dump at the end of this file,
  104. # the fileset will be reloaded the next time you run Alpha.
  105. #===========================================================================
  106. proc dumpFileset {} {
  107.     global fileSets
  108.     global currFileSet
  109.     if {![catch {prompt "Fileset name:" $currFileSet} name]} {
  110.         insertText "set \"fileSets($name)\" \{\r"
  111.         foreach file "$fileSets($name)" {
  112.             insertText "\t\"$file\"\r"
  113.         }
  114.         insertText "\}\r"
  115.     }
  116. }
  117.  
  118.  
  119.  
  120. #================================================================================
  121. # Edit a file from a fileset via list dialogs (no mousing around).
  122. #================================================================================
  123. proc editFile {} {
  124.     global fileSets
  125.     
  126.     set fset [listpick -p {Fileset?} [lsort -ignore [array names fileSets]]]
  127.     if {[string length $fset]} {
  128.         foreach f $fileSets($fset) {
  129.             lappend disp [file tail $f]
  130.         }
  131.         set res [listpick -p {File?} [lsort -ignore $disp]]
  132.         if {[string length $res]} {
  133.             set ind [lsearch $fileSets($fset) \*$res]
  134.             edit [lindex $fileSets($fset) $ind]
  135.         }
  136.     }
  137. }
  138.  
  139. #===========================================================================
  140. # Must stay the last thing in the file! We need this so that all the 
  141. # filesets defined above make it into the menu.
  142. #===========================================================================
  143. menu -n choose -m -p changeFileSet [lsort [array names fileSets]]
  144. markMenuItem -m choose $currFileSet on
  145.  
  146.  
  147.  
  148. #================================================================================
  149. # Create a heirarchical fileset menu that allows you 
  150. # to open any file in any fileset.
  151. #
  152. # Doesn't bother trying to specialcase names or pathnames that have
  153. # non-alphanumeric characters in them.
  154.  
  155. proc filesetProc {menu item} {
  156.     global fileSets
  157.     if {[set match [lsearch $fileSets($menu) *:$item]] >= 0} {
  158.         edit [lindex $fileSets($menu) $match]
  159.     }
  160. }    
  161.  
  162. proc makeFilesetMenu {} {
  163.     global fileSets fsetMenuName
  164.     foreach f [lsort [array names fileSets]] {
  165.         if {$f == "Help"} continue
  166.         set menu {}
  167.         foreach m $fileSets($f) {
  168.             lappend menu [file tail $m]
  169.         }
  170.         lappend sets [list menu -m -n $f -p filesetProc [lsort -i $menu]]
  171.     }
  172.     menu -n $fsetMenuName -p filesetProc $sets
  173. }
  174.  
  175.